perm filename EUCLID.FAI[GEM,HE] blob
sn#224853 filedate 1976-07-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00029 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE EUCLID - EUCLIDEAN ROUTINES - BRUCE G. BAUMGART - JULY 1972.
C00006 00003 SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) OBJECT TRANSLATION WRT TRAM.
C00008 00004 SUBR(ROTATE,FRMOBJ,CX,CY,CZ) OBJECT ROTATION WRT TRAM.
C00011 00005 SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) DILATION-REFLECTION WRT TRAM.
C00012 00006 SUBR(APTRAM,ENTITY,T) APPLY TRAM TO THE OBJECT.
C00016 00007 SUBN(SCREW)
C00018 00008 SUBR(INTRAM,T) INVERT A TRAM
C00020 00009 SUBR(MKTRMA,PAN,TILT,SWING) MAKE TRAM FROM EULER ANGLES.
C00022 00010 SUBR(MKTRMF,FACE) MAKE TRAM FROM A FACE.
C00024 00011 SUBR(MKTRMV,WX,WY,WZ) MAKE TRAM FROM A VECTOR.
C00027 00012 SUBR(CVTRMV,TRM) CONVERT TRAM INTO ROTATION VECTOR.
C00029 00013 SUBR(NORM,T) NORMALIZE A TRAM MATRIX.
C00031 00014 SUBR(ORTHO1,T) ORTHOGONALIZE by worst case.
C00034 00015 SUBR(ORTHO2,QTRAM) ORTHOGONALIZE A MATRIX.
C00036 00016 SUBR(DETERM,T)
C00037 00017 SUBR(ANGL3V,VERT1,VERT2,VERT3) ANGLE TRI-VERTEX.
C00039 00018 SUBR(DISTAN,V1,V2) DISTANCE BETWEEN TWO VERTICES.
C00040 00019 COMMENT ENORM & VNORM
C00042 00020 SUBR(QEV,EDGE,VERTEX) DISTANCE VERTEX TO EDGE.
C00044 00021 SUBR(ZDEPTH,FACE,VERTEX) ZPP DEPTH.
C00046 00022 DEFINE TJOINT(Q,V)<CAR Q,2(V)>
C00048 00023 SUBR(PPROJ,CAMERA,WORLD)
C00050 00024 SUBR(VPROJ,VERTEX,CAMERA) VERTEX PERSPECTIVE PROJECTION.
C00052 00025 SUBR(UNPROJECT,VERTEX,CAMERA)
C00054 00026 SUBR(FACOEF,BF) FACE COEFFICIENTS. BF>0 WC, BF<0 PP.
C00057 00027 SUBR(WITH3D,FACE,X,Y,Z) TEST FOR LOCUS WITHIN FACE 3D.
C00060 00028 SUBR(SOLANG,VERTEX) DIHEDRAL ANGLE AT A PIERCING VERTEX.
C00062 00029 EUCLID.FAI - EOF.
C00063 ENDMK
C⊗;
TITLE EUCLID - EUCLIDEAN ROUTINES - BRUCE G. BAUMGART - JULY 1972.
EUCORG↑:0 ;EUCLID PROGRAM ORIGIN.
.INSERT MN
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKCOPY,MKTRAM,KLNODE
EXTERN SIN,COS,SQRT,ATAN,ATAN2,ASIN,ACOS,LOG,HALFPI,PI,TWOPI
COMMENT ⊗----------------------------------------------------------------------
EUCLIDEAN TRANSFORMATIONS
TRAM ← TRANSL(XWD(TRAM,ENTITY),DX,DY,DZ);
TRAM ← ROTATE(XWD(TRAM,ENTITY),WX,WY,WZ);
TRAM ← SHRINK(XWD(TRAM,ENTITY),KX,KY,KZ);
TRAM ← APTRAM(ENTITY,TRAM); {SCREW}
TRAM ← INTRAM(TRAM);
TRAM MAKERS
TRAM ← MKTRMA(PAN,TILT,SWING); MAKE TRAM FROM ANGLES.
TRAM ← MKTRMF(FACE); MAKE TRAM FROM FACE.
TRAM ← MKTRMV(WX,WY,WZ); MAKE TRAM FROM ROTATION VECTOR.
ORTHONORMALIZATION.
NORM(TRAM) ;NORMALIZATION TO UNIT VECTORS.
ORTHO1(TRAM) ;ORTHOGONALIZE BY WORST CASE.
ORTHO2(TRAM) ;ORTHOGONALIZE BY K ← (I CROSS J), J ← (K CROSS I).
GEOMETRIC MEASURE ROUTINES.
DETERM(TRAM)
ANGL3V(V1,V2,V3)
DISTANCE(ENTITY,ENTITY);
VECTOR ROUTINES.
TENSOR ROUTINES.
SPATIAL PREDICATES.
IMAGE PROJECTION.
------------------------------------------------------------------------------⊗
SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) ;OBJECT TRANSLATION WRT TRAM.
COMMENT .-----------------------------------------------------------.
CALL(MKTRAM)
HRLZI DX↔HRRI XWC(1)↔BLT ZWC(1) ;DELTA'S OF TRANSLATION.
↑QTRAN: DAC 1,TMP1 ;SECOND ENTRY.
HRRE 2,FRMOBJ↔MOVMS 2↔DAC 2,OBJECT
HLRE 1,FRMOBJ↔SKIPGE 1↔GO[
SETZ 1,↔JUMPE 2,.+1 ;JUMP WHEN NO OBJECT.
CALL(BGET,OBJECT) ;GET BODY OF THE OBJECT.
TRAM 1,1↔GO .+1] ;GET TRAM OF THE BODY.
DAC 1,REFRAM ;TRANS/FRAME.
LAC 1,TMP1↔SKIPN REFRAM↔GO L1
L0: SETQ(TMP2,{MKCOPY,REFRAM})
HLRE FRMOBJ↔CAMN [-2]↔GO[
SETZM IX(1)↔MOVEI IY(1)↔DIP 1,0↔BLT KZ(1) ;UNIT MATRIX
MOVSI(<1.0>)↔ DAC IX(1)↔DAC JY(1)↔DAC KZ(1)↔GO .+1]
SETQ(TMP3,{MKCOPY,TMP2})
CALL(INTRAM,TMP2)
CALL(APTRAM,TMP2,TMP1)
CALL(APTRAM,TMP2,TMP3)
CALL(KLNODE,TMP3)
CALL(KLNODE,TMP1)
LAC 1,TMP2↔DAC 1,TMP1 ;TMP1 ← TMP2.
L1: SKIPN OBJECT↔POP4J ;RETURN TRANSFORMATION.
CALL(APTRAM,OBJECT,TMP1)
CALL(KLNODE,TMP1)
LAC 1,OBJECT↔POP4J ;RETURN THE OBJECT.
DECLARE{TMP1,TMP2,TMP3,REFRAM,OBJECT}
ENDR TRANSLATE;3/18/73(BGB)------------------------------------------
SUBR(ROTATE,FRMOBJ,CX,CY,CZ) ;OBJECT ROTATION WRT TRAM.
COMMENT .---------------------------------------------------------------------.
;COMPONENTS OF ROTATION VECTOR.
SKIPE 1,CX↔FMPR 1,1↔LAC 1
SKIPE 1,CY↔FMPR 1,1↔FADR 1
SKIPE 1,CZ↔FMPR 1,1↔FADR 1
JUMPE POP4J.
SETQ(W,{SQRT↑,0}) ;RADIANS OF ROTATION.
SETQ(C,{COS,W})
SETQ(S,{SIN,W})
MOVSI (<1.0>)↔FDVR W
FMPRM CX↔FMPRM CY↔FMPRM CZ ;NORMALIZE INTO THE STACK.
;COMPUTE ROTATION MATRIX.
;1/ (1-CW)*CX↑2 + CW 2/ (1-CW)*CX*CY + CZ*SW 3/ (1-CW)*CX*CZ - CY*SW
;4/ (1-CW)*CX*CY - CZ*SW 5/ (1-CW)*CY↑2 + CW 6/ (1-CW)*CY*CZ + CX*SW
;7/ (1-CW)*CX*CZ + CY*SW 8/ (1-CW)*CY*CZ - CX*SW 9/ (1-CW)*CZ↑2 + CW
MOVSI 1,(<1.0>)↔FSBR 1,C ; (1-C) IN ALL POSITIONS.
LAC[XWD 1,2]↔BLT 9
FMPR 1,CX↔FMPR 1,CX↔FADR 1,C ;DIAGONAL ELEMENTS.
FMPR 5,CY↔FMPR 5,CY↔FADR 5,C
FMPR 9,CZ↔FMPR 9,CZ↔FADR 9,C
LAC CX↔FMPR CY↔FMPR 2,↔FMPR 4, ;(1-CW) PRODUCTS.
LAC CX↔FMPR CZ↔FMPR 3,↔FMPR 7,
LAC CY↔FMPR CZ↔FMPR 6,↔FMPR 8,
LAC CX↔FMPR S↔FADR 6,↔FSBR 8, ;CX*S PRODUCTS.
LAC CY↔FMPR S↔FADR 7,↔FSBR 3, ;CY*S
LAC CZ↔FMPR S↔FADR 2,↔FSBR 4, ;CZ*S
CALL(MKNODE↑,1)↔DAC 1,TMP1
MOVSI 2↔HRRI IY(1)↔BLT KZ(1)
GO QTRAN
DECLARE{W,C,S,TMP1}
ENDR ROTATE; BGB & HANS P. MORAVEC & MACSYMA 3 JUNE 1974 ----------------------
SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) ;DILATION-REFLECTION WRT TRAM.
COMMENT .-----------------------------------------------------------.
CALL(MKTRAM)
SKIPN 2,KKX↔MOVSI 2,(1.0)↔DAC 2,IX(1)
SKIPN 2,KKY↔MOVSI 2,(1.0)↔DAC 2,JY(1)
SKIPN 2,KKZ↔MOVSI 2,(1.0)↔DAC 2,KZ(1)↔GO QTRAN
ENDR SHRINK;3/18/73(BGB)---------------------------------------------
SUBR(APTRAM,ENTITY,T); APPLY TRAM TO THE OBJECT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,X,Y,Z,TRN,N,OBJ,E0}
SKIPE OBJ,ENTITY↔SKIPN TRN,T↔POP2J ;IGNORE ZERO ARGS.
MOVM 1,(OBJ)↔JUMPE 1,LROTA ;GET TYPE OF OBJECT.
TLNE 1,(1B9)↔GO LROTA ;TRAM.
ANDI 1,17↔GO @.+1(1) ;DISPATCH ON TYPE OF OBJECT.
POP2J.↔POP2J.↔POP2J.↔CROTA ;TRAM EMPTY UNIVERSE SUN
CROTA↔POP2J.↔POP2J.↔POP2J. ;CAMERA WORLD WINDOW IMAGE
POP2J.↔POP2J.↔POP2J.↔POP2J. ;TEXT XNODE YNODE ZNODE
BROTA↔FROTA↔EROTA↔VROTA ;BODY FACE EDGE VERTEX
;....................................................................
LROTA: LAC V,OBJ↔SETZM TMP2#↔GO .+3 ;TRAM CASE.
CROTA: TRAM V,OBJ↔DAC V,TMP2# ;CAMERA & SUN CASE.
CALL(SCREW)
PUSH P,XWC(TRN)↔PUSH P,YWC(TRN)↔PUSH P,ZWC(TRN)
SETZM XWC(TRN)↔SETZM YWC(TRN)↔SETZM ZWC(TRN)
ADDI V,3↔CALL(SCREW)
ADDI V,3↔CALL(SCREW)
ADDI V,3↔CALL(SCREW)
POP P,ZWC(TRN)↔POP P,YWC(TRN)↔POP P,XWC(TRN)
SKIPN TMP2↔POP2J
CALL(NORM,TMP2#)
CALL(ORTHO1,TMP2#)↔POP2J
;....................................................................
BROTA: LAC B,OBJ ;BODY ROTATION.
TESTZ B,BDVBIT↔GO L2 ;DON'T MOVE VERTICES.
LAC V,B ;1ST VERTEX.
L1: PVT V,V
CAMN V,OBJ↔GO L2 ;SKIP WHEN VERTEX.
CALL(SCREW)↔GO L1 ;ROTATE VERTEX.
L2: LAC B,OBJ
TESTZ B,BDLBIT↔GO L3 ;DON'T MOVE TRAM.
TRAM V,B↔SKIPN V↔GO L3
DAC V,TMP#↔PUSH P,B
CALL(APTRAM,V,TRN) ;BODY'S TRAM.
CALL(NORM,TMP#)
CALL(ORTHO1,TMP#)↔POP P,B
;PARTS OF THIS BODY.
L3: TESTZ B,BDPBIT↔POP2J ;DON'T MOVE PARTS.
SON N,B↔JUMPE N,POP2J.
L4: CALL(APTRAM,N,N,TRN)
POP P,N↔LAC B,ENTITY
BRO N,N↔SON 0,B
CAME 0,N↔GO L4↔POP2J
;....................................................................
FROTA: LAC F,OBJ↔NCNT N,F↔MOVMS N ;FACE ROTATION.
PED E,F↔DAC E,E0↔JUMPE E0,[ ;VERTEX FACE.
PFACE B,F↔PVT V,B↔CALL(SCREW)↔POP2J]
PCW 0,E↔SKIPN N↔CAMN 0,E↔GO[ ;WIRE OR SHELL FACE.
SETQ(V,{VCW,E,F})↔CALL(SCREW)↔GO .+1]
L5: SETQ(V,{VCCW,E,F})
CALL(SCREW)↔CALL(ECCW,E,F)
CAMN 1,E↔POP2J ;END OF WIRE FACE.
LAC E,1↔CAMN E,E0↔POP2J ;END OF NORMAL FACE.
SOJN N,L5↔POP2J ;END OF SHELL FACE.
;....................................................................
EROTA: LAC E,OBJ ;EDGE ROTATION
PVT V,E↔CALL(SCREW)
NVT V,E↔CALL(SCREW)↔POP2J
VROTA: LAC V,OBJ↔CALL(SCREW)↔POP2J ;VERTEX ROTATION.
ENDR APTRAM;1/14/73(BGB)------------------------------------------
SUBN(SCREW)
COMMENT ⊗------------------------------------------------------------
; APTRAM's inner most subroutine.
; Expects arguments in V and Q. Clobbers 1,2,X,Y,Z.
;
; X ← XWC(V);
; Y ← YWC(V);
; Z ← ZWC(V);
;
; XWC(V) ← X*IX(Q) + Y*JX(Q) + Z*KX(Q) + XWC(Q);
; YWC(V) ← X*IY(Q) + Y*JY(Q) + Z*KZ(Q) + YWC(Q);
; ZWC(V) ← X*IZ(Q) + Y*JZ(Q) + Z*KZ(Q) + ZWC(Q);
⊗
ACCUMULATORS{B,F,E,V,X,Y,Z,Q}
LAC X,XWC(V)↔LAC Y,YWC(V)↔LAC Z,ZWC(V)
LAC 1,IX(Q)↔CAMN 1,[1.0]↔SKIPA 1,X↔FMPR 1,X
SKIPE 2,JX(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,KX(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,XWC(Q)↔FADR 1,2↔DAC 1,XWC(V)
LAC 1,JY(Q)↔CAMN 1,[1.0]↔SKIPA 1,Y↔FMPR 1,Y
SKIPE 2,IY(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,KY(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,YWC(Q)↔FADR 1,2↔DAC 1,YWC(V)
LAC 1,KZ(Q)↔CAMN 1,[1.0]↔SKIPA 1,Z↔FMPR 1,Z
SKIPE 2,JZ(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,IZ(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,ZWC(Q)↔FADR 1,2↔DAC 1,ZWC(V)
POP0J
ENDR SCREW;3/18/73(BGB)-------------------------------------------
SUBR(INTRAM,T) ;INVERT A TRAM
COMMENT .-----------------------------------------------------------.
Q ←← 6
DAC 16,SAVE16 ; DON'T FORGET THE STRING STACK POINTER
LAC 2,T
MOVSI XWC(2)↔HRRI XWC+Q↔BLT KZ+Q
;XWC' ← -(XWC*IX + YWC*IY + ZWC*IZ);
LAC 1,XWC+Q↔FMPR 1,IX+Q
LAC YWC+Q↔FMPR IY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR IZ+Q↔FADR 1,0
MOVNM 1,XWC(2)
;YWC' ← -(XWC*JX + YWC*JY + ZWC*JZ);
LAC 1,XWC+Q↔FMPR 1,JX+Q
LAC YWC+Q↔FMPR JY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR JZ+Q↔FADR 1,0
MOVNM 1,YWC(2)
;ZWC' ← -(XWC*KX + YWC*KY + ZWC*KZ);
LAC 1,XWC+Q↔FMPR 1,KX+Q
LAC YWC+Q↔FMPR KY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR KZ+Q↔FADR 1,0
MOVNM 1,ZWC(2)
;TRANSPOSE ROTATION MATRIX.
DAC JX+Q,IY(2)
DAC KX+Q,IZ(2)
DAC IY+Q,JX(2)
DAC KY+Q,JZ(2)
DAC IZ+Q,KX(2)
DAC JZ+Q,KY(2)
LAC 1,2
LAC 16,SAVE16 ; GET STRING STACK POINTER BACK
POP1J
DECLARE(SAVE16)
ENDR INTRAM;3/18/73(BGB)---------------------------------------------
SUBR(MKTRMA,PAN,TILT,SWING) ;MAKE TRAM FROM EULER ANGLES.
COMMENT .-----------------------------------------------------------.
SETQ(CP,{COS,PAN})↔ SETQ(SP,{SIN,PAN})
SETQ(CT,{COS,TILT})↔ SETQ(ST,{SIN,TILT})
SETQ(CS,{COS,SWING})↔ SETQ(SS,{SIN,SWING})
CALL(MKTRAM)
LAC SP↔FMP CT↔FMP SS↔DAC 2↔LAC CP↔FMP CS↔FSB 2↔DAC IX(1)
LAC CP↔FMP CT↔FMP SS↔DAC 2↔LAC SP↔FMP CS↔FAD 2↔DAC IY(1)
LAC ST↔FMP SS↔DAC IZ(1)
LAC SP↔FMP CT↔FMP CS↔DAC 2↔LAC CP↔FMP SS↔FAD 2↔MOVNM JX(1)
LAC CP↔FMP CT↔FMP CS↔DAC 2↔MOVN SP↔FMP SS↔FAD 2↔DAC JY(1)
LAC ST↔FMP CS↔DAC JZ(1)
LAC SP↔FMP ST↔DAC KX(1)
LAC CP↔FMP ST↔MOVNM KY(1)
LAC CT↔DAC KZ(1)↔POP3J
DECLARE{CP,CT,CS,SP,ST,SS}
ENDR MKTRMA;10/30/73(BGB)--------------------------------------------
SUBR(MKTRMF,FACE) ;MAKE TRAM FROM A FACE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,E0,V,X,Y,Z,N}
LAC F,FACE↔PED E,F↔DAC E,E0
SETZB X,Y↔SETZB Z,N
L1: SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F})
FADR X,XWC(V)↔FADR Y,YWC(V)↔FADR Z,ZWC(V)
CAME E,E0↔AOJA N,L1↔AOS N
;CENTER OF FACE BECOMES ORIGIN.
FLOAT N,↔FDVR X,N↔FDVR Y,N↔FDVR Z,N
SETQ(F,{MKTRAM})↔DAC F,TRM#
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)
;FIRST TWO VECTORS.
SETQ(V,{VCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC IX(F)
LAC YWC(V)↔FSBR Y↔DAC IY(F)
LAC ZWC(V)↔FSBR Z↔DAC IZ(F)
SETQ(V,{VCCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC JX(F)
LAC YWC(V)↔FSBR Y↔DAC JY(F)
LAC ZWC(V)↔FSBR Z↔DAC JZ(F)
CALL(ORTHO2,TRM)
CALL(NORM,TRM)
CALL(ORTHO1,TRM)
LAC 1,TRM↔POP1J
ENDR MKTRMF;2/19/74(BGB)---------------------------------------------
SUBR(MKTRMV,WX,WY,WZ) ;MAKE TRAM FROM A VECTOR.
COMMENT .-----------------------------------------------------------.
;COMPONENTS OF ROTATION VECTOR.
SKIPE 1,WX↔FMPR 1,1↔LAC 1
SKIPE 1,WY↔FMPR 1,1↔FADR 1
SKIPE 1,WZ↔FMPR 1,1↔FADR 1
JUMPE [CALL(MKTRAM)↔POP3J]
SETQ(W,{SQRT↑,0}) ;RADIANS OF ROTATION.
SETQ(C,{COS,W})
SETQ(S,{SIN,W})
MOVSI (<1.0>)↔FDVR W
FMPRM WX↔FMPRM WY↔FMPRM WZ ;NORMALIZE INTO THE STACK.
;COMPUTE ROTATION MATRIX.
;1/ (1-CW)*CX↑2 + CW 2/ (1-CW)*CX*CY + CZ*SW 3/ (1-CW)*CX*CZ - CY*SW
;4/ (1-CW)*CX*CY - CZ*SW 5/ (1-CW)*CY↑2 + CW 6/ (1-CW)*CY*CZ + CX*SW
;7/ (1-CW)*CX*CZ + CY*SW 8/ (1-CW)*CY*CZ - CX*SW 9/ (1-CW)*CZ↑2 + CW
MOVSI 1,(<1.0>)↔FSBR 1,C ; (1-CW) IN ALL POSITIONS.
LAC[XWD 1,2]↔BLT 9
FMPR 1,WX↔FMPR 1,WX↔FADR 1,C ;DIAGONAL ELEMENTS.
FMPR 5,WY↔FMPR 5,WY↔FADR 5,C
FMPR 9,WZ↔FMPR 9,WZ↔FADR 9,C
LAC WX↔FMPR WY↔FMPR 2,↔FMPR 4, ;(1-CW) PRODUCTS.
LAC WX↔FMPR WZ↔FMPR 3,↔FMPR 7,
LAC WY↔FMPR WZ↔FMPR 6,↔FMPR 8,
LAC WX↔FMPR S↔FADR 6,↔FSBR 8, ;CX*S PRODUCTS.
LAC WY↔FMPR S↔FADR 7,↔FSBR 3, ;CY*S
LAC WZ↔FMPR S↔FADR 2,↔FSBR 4, ;CZ*S
CALL(MKNODE↑,1)
MOVSI 2↔HRRI IY(1)↔BLT KZ(1)
POP3J
DECLARE{W,C,S}
ENDR MKTRMV; BGB & HANS P. MORAVEC & MACSYMA 3 JUNE 1974 ----------------------
SUBR(CVTRMV,TRM) ;CONVERT TRAM INTO ROTATION VECTOR.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{Q}
;COS(W)← (IX + IY + IZ - 1)/2
LAC Q,TRM
LAC IX(Q)↔FADR JY(Q)↔FADR KZ(Q)
FSBRI (1.0)↔FSC -1↔DAC COSW#
MOVMS↔CAML [0.999999]↔GO[
SETZM XWC(Q)↔SETZM YWC(Q)↔SETZM ZWC(Q)↔LAC 1,Q↔POP1J]
; W ← ACOS(W) ANGLE OF ROTATION IN RADIANS.
CALL(ACOS↑,COSW)↔LAC Q,TRM
;SIGN(CX) ← SIGN(JZ-KY)
;SIGN(CY) ← SIGN(KX-IZ)
;SIGN(CZ) ← SIGN(IY-JX)
LAC JZ(Q)↔FSBR KY(Q)↔JUMPL[MOVNM 1,XWC(Q)↔GO .+2]↔DAC 1,XWC(Q)
LAC KX(Q)↔FSBR IZ(Q)↔JUMPL[MOVNM 1,YWC(Q)↔GO .+2]↔DAC 1,YWC(Q)
LAC IY(Q)↔FSBR JX(Q)↔JUMPL[MOVNM 1,ZWC(Q)↔GO .+2]↔DAC 1,ZWC(Q)
;TMP ← (1-CW)
MOVSI (<1.0>)↔FSBR COSW↔DAC TMP#
; WX ← W * SQRT((IX-CW)/TMP)
; WY ← W * SQRT((JY-CW)/TMP)
; WZ ← W * SQRT((KZ-CW)/TMP)
L1: LAC IX(Q)↔FSBR COSW↔FDVR TMP↔CALL(SQRT,0)↔FMPRM 1,XWC(Q)
LAC JY(Q)↔FSBR COSW↔FDVR TMP↔CALL(SQRT,0)↔FMPRM 1,YWC(Q)
LAC KZ(Q)↔FSBR COSW↔FDVR TMP↔CALL(SQRT,0)↔FMPRM 1,ZWC(Q)
LAC 1,TRM
POP1J
ENDR CVTRMV;1/15/75(BGB)---------------------------------------------
SUBR(NORM,T) ; NORMALIZE A TRAM MATRIX.
COMMENT .-----------------------------------------------------------.
;ACCUMULATORS:
; 05 06 07 IX IY IZ
; 10 11 12 JX JY JZ
; 13 14 15 KX KY KZ.
SAVAC(15)
MOVS T↔HRRI 5↔BLT 15
; R ← SQRT(A↑2+B↑2+C↑2); A←A/R; B←B/R; C←C/R;
FOR Q IN (5,10,13){
MOVM 1,Q↔CAMG 1,[1.0E-8]↔SETZB 1,Q↔FMPR 1,1
MOVM 1+Q↔CAMG 0,[1.0E-8]↔SETZB 1+Q↔FMPR↔FADR 1,0
MOVM 2+Q↔CAMG 0,[1.0E-8]↔SETZB 2+Q↔FMPR↔FADR 1,0
SKIPE 1↔CAMN 1,[1.0]↔GO .+6↔CALL(SQRT,1)
FDVR Q,1↔FDVR Q+1,1↔FDVR Q+2,1}
;PUT'EM DOWN.
LAC 1,T
MOVSI 5↔HRRI IX(1)↔BLT KZ(1)
GETAC(15)↔POP1J
ENDR NORM;1/14/73----------------------------------------------------
SUBR(ORTHO1,T) ; ORTHOGONALIZE by worst case.
COMMENT .-----------------------------------------------------------.
;IT IS ASSUMED THAT THE ROW VECTORS ARE UNIT VECTORS.
X←←0 ↔ Y←←1 ↔ Z←←2 ;ADDRESS DISPLACEMENTS.
Q←←9 ↔ R←←13 ↔ A←←14 ↔ B←←15 ;ACCUMULATORS.
SAVAC(15)↔SETOM FLG# ;FIRST TIME THRU FLAG.
L0: LAC R,T
MOVSI Q,IX(R)↔BLT Q,KZ ;FIRST NINE ACCUMULATORS.
;DOT EACH ROW VECTOR INTO THE NEXT ROW.
FMPR IX,JX↔FMPR IY,JY↔FMPR IZ,JZ
FADR IX,IY↔FADR IX,IZ
FMPR JX,KX↔FMPR JY,KY↔FMPR JZ,KZ
FADR JX,JY↔FADR JX,JZ
FMPR KX,IX(R)↔FMPR KY,IY(R)↔FMPR KZ,IZ(R)
FADR KX,KY↔FADR KX,KZ
;TAKE ABSOLUTE VALUES AND FIND THE WORST TOTAL COSINE.
MOVMS IX↔MOVMS JX↔MOVMS KX
LAC Q,KX↔FADR KX,JX↔FADR JX,IX↔FADR Q,IX
EXCH Q,JX↔SETZM SIGN#
MOVEI 1,IX(R)↔MOVEI 2,JX(R)↔MOVEI 3,KX(R) ;GET ROW POINTERS.
CAML Q,IX↔GO .+4
EXCH 2,1↔EXCH Q,IX↔SETCMM SIGN ;GET 2 BIGGER THAN 1.
CAML KX,Q↔GO .+4
EXCH 3,2↔EXCH KX,Q↔SETCMM SIGN ;GET 3 BIGGER THAN 2.
CAMG KX,[0.00001]↔GO L1 ;GOOD ENUF FOR GOVERNMENT WORK.
;STRAIGHTEN UP THE WORST VECTOR.
LAC A,Y(1)↔FMPR A,Z(2)
LAC B,Y(2)↔FMPR B,Z(1)↔FSBR A,B↔DAC A,X(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM X(3)
LAC A,X(2)↔FMPR A,Z(1)
LAC B,X(1)↔FMPR B,Z(2)↔FSBR A,B↔DAC A,Y(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Y(3)
LAC A,X(1)↔FMPR A,Y(2)
LAC B,X(2)↔FMPR B,Y(1)↔FSBR A,B↔DAC A,Z(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Z(3)
SKIPE SIGN↔GO[MOVNS X(3)↔MOVNS Y(3)↔MOVNS Z(3)↔GO .+1]
SKIPN FLG↔GO L1↔SETZM FLG↔GO L0
L1: GETAC(15)↔POP1J
ENDR ORTHO1;1/14/73(BGB)---------------------------------------------
SUBR(ORTHO2,QTRAM) ;ORTHOGONALIZE A MATRIX.
COMMENT .-----------------------------------------------------------.
;ACCEPT I; K' ← I CROSS J; J' ← K CROSS I;
LAC 1,QTRAM
SETZM KX(1)↔SETZM KY(1)↔SETZM KZ(1)
MOVS QTRAM↔HRRI 1↔BLT 9
LAC 12,4↔LAC 13,5↔LAC 14,6 ;SAVE J VECTOR.
;VECTOR-K ← VECTOR-I CROSS VECTOR-J.
LAC 2↔FMP 6↔DAC 7
LAC 5↔FMP 3↔FSB 7,
LAC 4↔FMP 3↔DAC 8
LAC 1↔FMP 6↔FSB 8,
LAC 1↔FMP 5↔DAC 9
LAC 4↔FMP 2↔FSB 9,
;VECTOR-J ← VECTOR-K CROSS VECTOR-I.
LAC 8↔FMP 3↔DAC 4
LAC 2↔FMP 9↔FSB 4,
LAC 1↔FMP 9↔DAC 5
LAC 7↔FMP 3↔FSB 5,
LAC 7↔FMP 2↔DAC 6
LAC 1↔FMP 8↔FSB 6,
LAC 15,QTRAM↔MOVSI 1
HRRI IX(15)↔BLT KZ(15)
LAC 1,QTRAM↔POP1J
ENDR ORTHO2;3/30/73(BGB)---------------------------------------------
SUBR(DETERM,T)
COMMENT .-----------------------------------------------------------.
MOVS T↔HRRI 1↔BLT 9
LAC 5↔FMP 9↔LAC 12,
LAC 6↔FMP 8↔FSB 12,↔FMP 1,12
LAC 6↔FMP 7↔LAC 12,
LAC 4↔FMP 9↔FSB 12,↔FMP 2,12↔FAD 1,2
LAC 4↔FMP 8↔LAC 12,
LAC 5↔FMP 7↔FSB 12,↔FMP 3,12↔FAD 1,3↔POP1J
ENDR DETERM;4/1/73(BGB)----------------------------------------------
SUBR(ANGL3V,VERT1,VERT2,VERT3) ;ANGLE TRI-VERTEX.
COMMENT .-----------------------------------------------------------.
;ANGLE V1,V2,V3 CCW; RETURNS VALUE 0 TO 2π.
V1 ←← 13
V2 ←← 14
V3 ←← 15
;DETERMINE WHETHER THE ANGLE IS MORE OR LESS THAN PI.
LAC V1,VERT1↔MOVSI XWC(V1)↔HRRI 1↔BLT 3
LAC V2,VERT2↔MOVSI XWC(V2)↔HRRI 4↔BLT 6
LAC V3,VERT3↔MOVSI XWC(V3)↔HRRI 7↔BLT 9
FSBR 1,4↔FSBR 2,5↔FSBR 3,6 ;V1' ← (V1-V2).
FSBR 7,4↔FSBR 8,5↔FSBR 9,6 ;V3' ← (V3-V2).
LAC 2↔FMP 9↔LAC 4,↔LAC 3↔FMP 8↔FSB 4, ;V2' ← (V1 X V3).
LAC 3↔FMP 7↔LAC 5,↔LAC 1↔FMP 9↔FSB 5,
LAC 1↔FMP 8↔LAC 6,↔LAC 2↔FMP 7↔FSB 6,
FADR 1,4↔FADR 2,5↔FADR 3,6 ;V1" ← (V1'+V2').
FADR 7,4↔FADR 8,5↔FADR 9,6 ;V3" ← (V3'+V2').
;DETERM NGEATIVE INDICATES CCW ORDER, 0 TO π.
;DETERM POSITIVE INDICATES CW ORDER, π T0 2π.
CALL({DETERM+3},0)
SKIPL 1↔SKIPA 1,PI↔SETZ 1,↔PUSH P,1
;COSINE LAW.
CALL(DISTANCE,V2,V1)↔PUSH P,1
CALL(DISTANCE,V2,V3)↔PUSH P,1
CALL(DISTANCE,V1,V3)
FMPR 1,1↔MOVNS 1
POP P,2↔LAC 2↔FMPR 2,2
POP P,3↔FMP 3↔FMPR 3,3
FSC 1↔FADR 1,2↔FADR 1,3
FDVR 1,0↔CALL(ACOS,1)
POP P,0↔FADR 1,0↔POP3J
ENDR ANGL3V;4/1/73(BGB)----------------------------------------------
SUBR(DISTAN,V1,V2) ;DISTANCE BETWEEN TWO VERTICES.
COMMENT .-----------------------------------------------------------.
LAC 1,V1↔LAC 2,V2
LAC XWC(1)↔FSBR XWC(2)↔FMPR↔DAC 3
LAC YWC(1)↔FSBR YWC(2)↔FMPR↔FADRM 3
LAC ZWC(1)↔FSBR ZWC(2)↔FMPR↔FADR 3
CALL(SQRT,0)↔POP2J
ENDR DISTAN;2/10/73(BGB)---------------------------------------------
COMMENT ⊗ ENORM & VNORM
SUBR(ENORM,BODY) ;COMPUTE EDGE NORMALS FROM FACE NORMALS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,F1,F2}
LAC E,BODY
L1: PED E,E↔CAMN E,BODY↔POP1J
PFACE F1,E↔NFACE F2,E
LAC AA(F1)↔FAD AA(F2)↔FSC -1↔MOVNM AA(E)
LAC BB(F1)↔FAD BB(F2)↔FSC -1↔MOVNM BB(E)
LAC CC(F1)↔FAD CC(F2)↔FSC -1↔MOVNM CC(E)
GO L1
ENDR ENORM;1/14/73(BGB)----------------------------------------------
SUBR(VNORM,BODY) ;COMPUTE VERTEX NORMALS FROM EDGE NORMALS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V,E,E0,A,B,C}
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
PED E,V↔SKIPN E0,E↔POP1J ;VERTEX BODY CASE.
SETZB 0,A↔SETZB B,C
L2: FAD A,AA(E)↔FAD B,BB(E)↔FAD C,CC(E)
PVT 1,E↔CAME 1,V↔GO .+3↔PCW E,E↔GO .+5
NVT 1,E↔CAME 1,V↔AOJA .+5↔NCW E,E
CAME E,E0↔AOJA L2↔AOS
FLOAT↔FDV A,↔FDV B,↔FDV C,
DAC A,XPP(V)↔DAC B,YPP(V)↔DAC C,ZPP(V)
GO L1
ENDR VNORM;1/14/73(BGB)----------------------------------------------
⊗
SUBR(QEV,EDGE,VERTEX) ;DISTANCE VERTEX TO EDGE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V}
LAC V,VERTEX↔LAC E,EDGE↔LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
POP2J
ENDR QEV;2/10/73(BGB)________________________________________________
SUBR(QFEV,FACE,EDGE,VERTEX) ;DIRECTED DISTANCE VERTEX TO EDGE.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V}
LAC V,VERTEX↔LAC E,EDGE↔LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,FACE↔MOVNS 1
POP3J
ENDR QFEV;2/10/73(BGB)_______________________________________________
SUBR(CROSSING,X,Y,EDGE1,EDGE2)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
LAC E1,EDGE1↔LAC E2,EDGE2
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@X
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC@Y
POP4J
ENDR CROSSING;2/10/73(BGB)-------------------------------------------
SUBR(ZDEPTH,FACE,VERTEX) ;ZPP DEPTH.
COMMENT .------------------------------------------------------------
Return AC0 =-1 when vertex is under the face;
Return AC0 = 0 when vertex is above the face;
Return AC1 = ZPP depth = (KK-AA*Xpp-BB*Ypp)/CC .
ACCUMULATORS{F,V}
EXCH V,VERTEX↔EXCH F,FACE ;GET ARGS & SAVE ACS.
LAC 1,KK(F)
LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
FDVR 1,CC(F)
SETO↔CAMG 1,ZPP(V)↔SETZ ;ZPP-OVER > ZPP-UNDER.
EXCH V,VERTEX↔EXCH F,FACE ;RESTORE ACCUMULATORS.
POP2J
ENDR ZDEPTH;2/10/73(BGB)---------------------------------------------
SUBR(ZDALT,FACE,X,Y)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F}
LAC F,FACE↔LAC 1,KK(F)
LAC AA(F)↔FMPR X↔FSBR 1,0
LAC BB(F)↔FMPR Y↔FSBR 1,0
FDVR 1,CC(F)↔POP3J
ENDR ZDALT;2/10/73(BGB)----------------------------------------------
DEFINE TJOINT(Q,V)<CAR Q,2(V)>
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
SUBR(WITHIN,FACE,VERTEX) ;WITHIN 2-D PP COORDINATES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,V,E,E0}
SAVAC(5)
LAC F,FACE↔LAC V,VERTEX↔PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,L3 ;VERTEX OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
CALL(LINKED↑,F,V)↔JUMPN 1,L3 ;NO SKIP - VERTEX IS PART OF THIS FACE.
TESTZ V,JUTBIT+JOTBIT↔GO[
TJOINT V,V↔CALL(LINKED↑,F,V)
JUMPN 1,L3↔GO .+1]
AOS(P) ;SKIP VERTEX WITHIN FACE.
L3: GETAC(5)
POP2J
ENDR WITHIN;2/27/73(BGB)---------------------------------------------
SUBR(WITH2D,FACE,X,Y) ;LOCUS WITHIN 2-D PP COORDINATES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,E,E0}
SAVAC(4)
LAC F,FACE↔PED E,F↔DAC E,E0
L1: LAC 1,CC(E)
LAC BB(E)↔FMPR Y↔FADR 1,0
LAC AA(E)↔FMPR X↔FADR 1,0
PFACE 0,E↔CAME 0,F↔MOVNS 1
L2: JUMPLE 1,L3 ;LOCUS IS OUTSIDE FACE.
SETQ(E,{ECCW,E,F})
CAME E,E0↔GO L1
AOS(P) ;SKIP LOCUS WITHIN FACE.
L3: GETAC(4)↔POP3J
ENDR WITH2D;BGB 28 APRIL 1974 ---------------------------------------
SUBR(PPROJ,CAMERA,WORLD)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ}
LAC B,WORLD↔$TYPE 0,B↔CAIE 0,$WORLD↔POP2J
;CLEAR FACE PZZ & NZZ BITS.
LAC B,WORLD
I0: CCW B,B↔CAME B,WORLD↔GO[LAC F,B
I1: PFACE F,F↔CAMN F,B↔GO I0↔MARKZ F,PZZ+NZZ↔GO I1]
;GET THE CAMERA'S TRAM.
LAC CAM,CAMERA
LAC 3(CAM)↔DAC FOCL# ;FOCAL PLANE DISTANCE.
TRAM CAM,CAM
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP2J
MARKZ B,VISIBLE
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: PVT V,V↔CAMN V,B↔GO L1
CALL(VPROJ,V,CAMERA)
;DO Z-CLIP MARKING WRT CAMERA CENTERED COORDINATES.
LAC 0,[JUTBIT+JOTBIT+PZZ+NZZ+FOLDED+VISIBLE+POTENT+7B20]
ANDCAM 0,(V) ;TURN 'EM ALL OFF.
MOVSI X,(PZZ) ; + HALFSPACE, BEHIND THE CAMERA.
MOVN FOCL
CAMGE ZZ,0 ;SKIP WHEN Zcc ≥ -FOCAL.
MOVSI X,(NZZ) ; - HALFSPACE, INVIEW.
IORM X,(V)
PED E,V↔DAC E,E0↔JUMPE E,[
PFACE F,B↔IORM X,(F)↔GO L1] ;VERTEX BODY CASE.
L3: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L4 ;AC1 ← ECCW(E,V).
NVT 1,E↔CAME 1,V↔GO L2 ↔NCW 1,E
L4: IORM X,(E)
PFACE F,E↔IORM X,(F)
NFACE F,E↔IORM X,(F)
LAC E,1↔CAME E,E0↔GO L3↔GO L2
ENDR PPROJ;1/14/73(BGB)----------------------------------------------
SUBR(VPROJ,VERTEX,CAMERA) ;VERTEX PERSPECTIVE PROJECTION.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ,TRM}
;PICKUP ARGUMENTS.
LAC CAM,CAMERA
TRAM TRM,CAM
LAC V,VERTEX
;TRANSLATE VERTEX TO CAMERA LOCUS.
LAC X,XWC(V)↔FSBR X,XWC(TRM)
LAC Y,YWC(V)↔FSBR Y,YWC(TRM)
LAC Z,ZWC(V)↔FSBR Z,ZWC(TRM)
;ROTATE TO CAMERA ORIENTATION.
LAC XX,X↔FMPR XX,IX(TRM)
LAC Y↔FMPR IY(TRM)↔FADR XX,
LAC Z↔FMPR IZ(TRM)↔FADR XX,
LAC YY,X↔FMPR YY,JX(TRM)
LAC Y↔FMPR JY(TRM)↔FADR YY,
LAC Z↔FMPR JZ(TRM)↔FADR YY,
LAC ZZ,X↔FMPR ZZ,KX(TRM)
LAC Y↔FMPR KY(TRM)↔FADR ZZ,
LAC Z↔FMPR KZ(TRM)↔FADR ZZ,
;PERSPECTIVE TRANSFORMATION.
;XPP(V) ← SCALEX * XCC/ZCC. SCALEX = -FOCAL/PDX.
;YPP(V) ← SCALEY * YCC/ZCC. SCALEY = -FOCAL/PDY.
;ZPP(V) ← SCALEZ /ZCC. SCALEZ = -FOCAL/PDZ.
;ZPP(V) IS POSITIVE WHEN VERTEX IS INVIEW. ←←← NOTA BENE.
MOVM ZZ↔CAMGE[1E-7]↔LAC ZZ,[1E-7] ;AVOID ZERO DIVIDE.
FMPR XX,-3(CAM)↔FDVR XX,ZZ↔DAC XX,XPP(V)
FMPR YY,-2(CAM)↔FDVR YY,ZZ↔DAC YY,YPP(V)
LAC Z,-1(CAM)↔FDVR Z,ZZ↔DAC Z,ZPP(V)
SETZM 7(V)↔POP2J ;CCW IS FOR SORT WINDOW V-LISTS.
ENDR VPROJ;(BGB)-----------------------------------------------------
SUBR(UNPROJECT,VERTEX,CAMERA)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V,C,R,X,Y,Z,XX,YY,ZZ}
;PICKUP ARGUMENTS.
LAC V,VERTEX
LAC C,CAMERA
TRAM R,C
;UNDO PERSPECTIVE.
LAC Z,-1(C)↔FDVR Z,ZPP(V) ;SCALEZ.
LAC Y,YPP(V)↔FMPR Y,Z↔FDVR Y,-2(C) ;SCALEY.
LAC X,XPP(V)↔FMPR X,Z↔FDVR X,-3(C) ;SCALEX.
;ROTATE BY TRANSPOSE OF CAMERA ORIENTATION.
LAC XX,X↔FMPR XX,IX(R)
LAC Y↔FMPR JX(R)↔FADR XX,
LAC Z↔FMPR KX(R)↔FADR XX,
LAC YY,X↔FMPR YY,IY(R)
LAC Y↔FMPR JY(R)↔FADR YY,
LAC Z↔FMPR KY(R)↔FADR YY,
LAC ZZ,X↔FMPR ZZ,IZ(R)
LAC Y↔FMPR JZ(R)↔FADR ZZ,
LAC Z↔FMPR KZ(R)↔FADR ZZ,
;TRANSLATE TO CAMERA LOCUS.
FADR XX,XWC(R)↔DAC XX,XWC(V)
FADR YY,YWC(R)↔DAC YY,YWC(V)
FADR ZZ,ZWC(R)↔DAC ZZ,ZWC(V)
POP2J
ENDR UNPROJECT;1/14/73(BGB)------------------------------------------
SUBR(FACOEF,BF) ;FACE COEFFICIENTS. BF>0 WC, BF<0 PP.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS {Q2,Q3,E,V1,V2,V3,ABC,F,ARG,E0}
FOR @% Qε{XYZ}{FOR @$ N←1,3{ ;DEFINE X1,Y1,Z1...
DEFINE Q%$N<Q%WC(V$N)>↔}}
;FOR ALL THE FACES OF EACH BODY.
MOVM F,BF↔LAC ARG,(F) ;ORIGINAL ARG TYPE.
TLNN ARG,(BBIT)↔GO L2
L1: PFACE F,F↔TEST F,FBIT↔POP1J
;FIRST THREE VERTICES CCW ABOUT THE FACE.
L2: PED E,F↔DAC E,E0
L3: SETQ(V1,{VCW,E,F})
SETQ(V2,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
SETQ(V3,{VCCW,E,F})
;FLG TRUE FOR PERSPECTIVE PROJECTED FACOEF.
SKIPG BF↔GO[ADDI V1,7↔ADDI V2,7↔ADDI V3,7↔GO .+1]
;KK(F) ← X1*(Z2*Y3-Y2*Z3) + Y1*(X2*Z3-Z2*X3) + Z1*(Y2*X3-X2*Y3).
LAC 1,Z2↔FMPR 1,Y3↔LAC Y2↔FMPR Z3↔FSBR 1,0↔FMPR 1,X1↔LAC 2,X2↔FMPR 2,Z3
LAC Z2↔FMPR X3↔FSBR 2,0↔FMPR 2,Y1↔FADR 1,2↔LAC 3,Y2↔FMPR 3,X3
LAC X2↔FMPR Y3↔FSBR 3,0↔FMPR 3,Z1↔FADR 1,3↔DAC 1,KK(F)
MOVMS 1↔CAML 1,[1.0]↔GO L4 ;SKIP KK TOO SMALL.
CAME E,E0↔GO L3
;AA(F) ← (Z1*(Y2-Y3) + Z2*(Y3-Y1) + Z3*(Y1-Y2)).
L4: LAC 1,Y2↔FSBR 1,Y3↔FMPR 1,Z1↔LAC 0,1
LAC 1,Y3↔FSBR 1,Y1↔FMPR 1,Z2↔FADR 0,1
LAC 1,Y1↔FSBR 1,Y2↔FMPR 1,Z3↔FADR 0,1↔DAC AA(F)↔FMPR↔DAC ABC
;BB(F) ← (X1*(Z2-Z3) + X2*(Z3-Z1) + X3*(Z1-Z2)).
LAC 1,Z2↔FSBR 1,Z3↔FMPR 1,X1↔LAC 0,1
LAC 1,Z3↔FSBR 1,Z1↔FMPR 1,X2↔FADR 0,1
LAC 1,Z1↔FSBR 1,Z2↔FMPR 1,X3↔FADR 0,1↔DAC BB(F)↔FMPR↔FADRM ABC
;CC(F) ← (X1*(Y3-Y2) + X2*(Y1-Y3) + X3*(Y2-Y1)).
LAC 1,Y3↔FSBR 1,Y2↔FMPR 1,X1↔LAC 0,1
LAC 1,Y1↔FSBR 1,Y3↔FMPR 1,X2↔FADR 0,1
LAC 1,Y2↔FSBR 1,Y1↔FMPR 1,X3↔FADR 0,1↔DAC CC(F)↔FMPR↔FADRM ABC
;NORMALIZE.
CALL(SQRT↑,ABC)↔MOVSI(<1.0>)↔FDVR 0,1
FMPRM AA(F)↔FMPRM BB(F)↔FMPRM CC(F)↔FMPRM KK(F)
TLNN ARG,(BBIT)↔POP1J↔GO L1
ENDR FACOEF;1/14/73(BGB)---------------------------------------------
SUBR(WITH3D,FACE,X,Y,Z) ;TEST FOR LOCUS WITHIN FACE 3D.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
LAC F,FACE
MOVM 1,AA(F)
MOVM 2,BB(F)
MOVM 3,CC(F)
MOVEI C0↔CAMG 1,2↔GO[
MOVEI C1↔CAMG 2,3↔MOVEI C2↔GO .+3]
CAMG 1,3↔MOVEI C2↔DAP CASE
;FIRST EDGE OF THE FACE.
SETOM FLG
PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,X
LAC DY2,YWC(V)↔FSB DY2,Y
LAC DZ2,ZWC(V)↔FSB DZ2,Z
L1: LAC DX1,DX2
LAC DY1,DY2
LAC DZ1,DZ2
LAC Q1,Q2
;NEXT EDGE OF THE FACE.
SETQ(V,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
LAC DX2,XWC(V)↔FSB DX2,X
LAC DY2,YWC(V)↔FSB DY2,Y
LAC DZ2,ZWC(V)↔FSB DZ2,Z
;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.
CASE: GO
C0: LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1: LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2: LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3: FSB 0,1↔DAC Q2
JUMPE 0,L3 ;LOCUS IS ON A FUCKING EDGE !
;DETECT SIGN CHANGE.
AOJE FLG,L2 ;JUMP ON FIRST TIME THRU.
XOR Q1↔JUMPL POP4J. ;NO SKIP RETURN FALSE.
L2: CAME E,E0↔GO L1
AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
L3: LAC DX1↔FMP DX2 ;COSINE.
LAC 1,DY1↔FMP 1,DY2↔FAD 0,1
LAC 1,DZ1↔FMP 1,DZ2↔FAD 0,1
SKIPGE↔AOS(P)↔POP4J ;SKIP RETURN TRUE - LOCUS IS WITHIN.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
SUBR(SOLANG,VERTEX) DIHEDRAL ANGLE AT A PIERCING VERTEX.
COMMENT .-----------------------------------------------------------.
EXTERN ACOS,DISTANCE,TWOPI
ACCUMULATORS{F,V}
LAC 1,VERTEX↔DAC 1,V0
PED 1,1↔DAC 1,E
SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV↑,F1,V0})
SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})
CALL(DISTANCE,V1,V0)↔PUSH P,1 ;L1
CALL(DISTANCE,V2,V0)↔PUSH P,1 ;L2
CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1 ;L3
;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
POP P,2↔POP P,3
LAC 2↔FMPR 3↔FSC 1
FMPR 2,2↔FMPR 3,3
FADR 1,2↔FADR 1,3
FDVR 1,0
CALL(ACOS,1)↔PUSH P,1
LAC V,V2↔LAC F,F1
LAC 0,XWC(V)↔FMPR 0,AA(F)
LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
POP P,1
CAML KK(F)↔POP1J↔MOVNS 1
FADR TWOPI↔POP1J ;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
;EUCLID.FAI - EOF.
EUCEND↑:0 ;EUCLID PROGRAM END.
END